home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / w3dvb5 / fstream.bas < prev    next >
Encoding:
BASIC Source File  |  1997-12-22  |  4.1 KB  |  218 lines
  1. Attribute VB_Name = "fStream"
  2.  
  3. ' Modulo per la lettura dei solidi in Input.
  4. ' Il modello Φ rappresentato nei files
  5. ' *.DAT
  6.  
  7.  
  8. Type FCoord
  9.   i As Integer              ' Numero Vertice
  10.   x As Double
  11.   Y As Double
  12.   Z As Double
  13. End Type
  14.  
  15. Type FVertex                ' Superfice
  16.      Count As Integer       ' Numero di Vertici
  17.      Vert(100) As Integer   ' Puntatori a FCoord
  18. End Type
  19.  
  20. Public FileCoord() As FCoord
  21. Public FileVertex() As FVertex
  22.  
  23. Public MaxVertNr As Integer
  24. Public MinVertNr As Integer
  25.  
  26. Sub GetVertexFromLine(St As String, FV As FVertex)
  27.          
  28.  ' Preleva i numeri di Vertice da un File di Win3D (L. Ammeraal)
  29.  
  30.  Dim j As Integer
  31.  Dim VaS As String
  32.  Dim VaN As Integer
  33.  Dim b As Integer
  34.  Dim Ch As String * 1
  35.    
  36.    For j = 1 To Len(St)
  37.        Ch = Mid$(St, j, 1)
  38.        If Ch <> " " Then
  39.           VaS = VaS + Ch
  40.        Else
  41.           If Len(VaS) > 0 Then
  42.                VaN = Val(VaS)
  43.                b = b + 1
  44.                FV.Vert(b) = Val(VaS)
  45.                VaS = ""
  46.           End If
  47.       End If
  48.   Next j
  49.    
  50.    
  51. ' Completa l'ultimo Vertice
  52.  
  53.     If Len(VaS) > 0 Then
  54.        b = b + 1
  55.        FV.Vert(b) = Val(VaS)
  56.     End If
  57.     
  58.     FV.Count = b
  59.  
  60. End Sub
  61.  
  62. Function LoadFile(File As String) As Integer
  63.   
  64.   Dim St As String
  65.   Dim nn As Integer
  66.   Dim Facce As Integer
  67.   Dim i As Integer
  68.   Dim x As Double
  69.   Dim Y As Double
  70.   Dim Z As Double
  71.   Dim Pl As Integer
  72.   Dim m As Integer
  73.   Dim Ps As Integer
  74.   Dim Vrt
  75.   
  76.   Erase FileCoord
  77.   Erase FileVertex
  78.   
  79.   LoadFile = True
  80.   
  81.   On Error Resume Next
  82.   nn = FreeFile
  83.   Open File For Input As nn
  84.   
  85.   If Err <> 0 Then
  86.      LoadFile = False
  87.      Exit Function
  88.   End If
  89.   
  90.   OpenFile = nn
  91.   
  92.  On Error GoTo 0
  93.  
  94.  ReDim FileCoord(1)
  95.  
  96.  Do Until EOF(nn)
  97.    
  98.    Line Input #nn, St
  99.    If Mid$(St, 1, 6) = "Faces:" Then
  100.       Facce = True
  101.       Line Input #nn, St
  102.    End If
  103.       
  104.    If Not Facce Then
  105.       Vrt = Vrt + 1
  106.       Call GetCoordFromLine(St, i, x, Y, Z)
  107.       If St = "FILE NON VALIDO" Then
  108.          LoadFile = False
  109.          Exit Function
  110.       End If
  111.       If Vrt > UBound(FileCoord) Then ReDim Preserve FileCoord(Vrt)
  112.       FileCoord(Vrt).i = i
  113.       FileCoord(Vrt).x = x
  114.       FileCoord(Vrt).Y = Y
  115.       FileCoord(Vrt).Z = Z
  116.    Else
  117.       
  118.          Pl = Pl + 1
  119.          ReDim Preserve FileVertex(Pl)
  120.          GetVertexFromLine St, FileVertex(Pl)
  121.          
  122.    End If
  123.  
  124.  
  125. Loop
  126.    
  127. Close nn%
  128.  
  129.  
  130. SetLimits
  131.  
  132. End Function
  133.  
  134. Sub GetCoordFromLine(St As String, i As Integer, x As Double, Y As Double, Z As Double)
  135.    On Error Resume Next
  136.  ' Preleva le coordinate da un File di Win3D (L. Ammeraal)
  137.  
  138.  Dim j As Integer
  139.  Dim VaS As String
  140.  Dim VaN As Double
  141.  Dim b As Integer
  142.    
  143.    For j = 1 To Len(St)
  144.        Ch = Mid$(St, j, 1)
  145.        If Ch <> " " Then
  146.           VaS = VaS + Ch
  147.        Else
  148.           If Len(VaS) > 0 Then
  149.                VaN = Val(VaS)
  150.                b = b + 1
  151.                Select Case b
  152.                  Case 1
  153.                     i = VaN
  154.                  Case 2
  155.                     x = VaN
  156.                  Case 3
  157.                     Y = VaN
  158.                  Case 4
  159.                     Z = VaN
  160.               End Select
  161.               VaS = ""
  162.           End If
  163.       End If
  164.   Next j
  165.    
  166.    
  167.    
  168. ' Completa la Z
  169.  
  170.     If Len(VaS) > 0 Then Z = Val(VaS)
  171.  
  172.     If i + x + Y + Z = 0 Then St = "FILE NON VALIDO"
  173.    
  174. End Sub
  175.  
  176.  
  177. Sub SetLimits()
  178.  
  179. ' Ritorna il numero massimo di Vertici
  180.  
  181. Dim i As Integer
  182. Dim k As Integer
  183. Dim x As Double
  184. Dim Y As Double
  185. Dim Z As Double
  186.  
  187. ' assegna il numero di vertici totale
  188. ' e le dimensioni min,max dell'oggetto
  189.  
  190. xmin = BIG
  191. xmax = -BIG
  192. ymin = BIG
  193. ymax = -BIG
  194. zmax = -BIG
  195. zmin = BIG
  196.  
  197. For k = 1 To UBound(FileCoord)
  198.  
  199.     i = FileCoord(k).i
  200.     x = FileCoord(k).x
  201.     Y = FileCoord(k).Y
  202.     Z = FileCoord(k).Z
  203.     
  204.     If (i > MaxVertNr) Then MaxVertNr = i
  205.     If (i < MinVertNr) Then MinVertNr = i
  206.     If (x < xmin) Then xmin = x
  207.     If (x > xmax) Then xmax = x
  208.     If (Y < ymin) Then ymin = Y
  209.     If (Y > ymax) Then ymax = Y
  210.     If (Z < zmin) Then zmin = Z
  211.     If (Z > zmax) Then zmax = Z
  212.  
  213. Next
  214.  
  215. End Sub
  216.  
  217.  
  218.